Cream of the Crop 26/Cream of the Crop 26.iso/program/p063b9s.zip/UNIT/ZMISC.PAS

Pascal/Delphi Source File | 1996-06-25 | 19KB | 756 lines

UNIT ZMisc;
{╔══════════════════════════════════════════════════════════════════════════╗}
{║ Global ZModem routines                        Last changed: 25.06.96  SA ║}
{║                                                                          ║}
{║                         (C) Copyright 1989-96 by                         ║}
{║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
{║                                                                          ║}
{║ This source may not be given to anybody, without the written permission  ║}
{║ from The Portal Team.                                                    ║}
{╚══════════════════════════════════════════════════════════════════════════╝}
{$I POPDEFS.INC}

INTERFACE

USES Use32, OpDate;

CONST
  ZPAD           = 42;            { '*'; }
  ZDLE           = 24;
  ZDLEE          = (ZDLE XOR 64);
  ZBIN           = 65;            { 'A'; }
  ZHEX           = 66;            { 'B'; }
  ZBIN32         = 67;            { 'C'; }

  {--------------------------------------------------------------------}
  { Frame types                                                        }
  {--------------------------------------------------------------------}
  ZRQINIT        = 0;
  ZRINIT         = 1;
  ZSINIT         = 2;
  ZACK           = 3;
  ZFILE          = 4;
  ZSKIP          = 5;
  ZNAK           = 6;
  ZABORT         = 7;
  ZFIN           = 8;
  ZRPOS          = 9;
  ZDATA          = 10;
  ZEOF           = 11;
  ZFERR          = 12;
  ZCRC           = 13;
  ZCHALLENGE     = 14;
  ZCOMPL         = 15;
  ZCAN           = 16;
  ZFREECNT       = 17;
  ZCOMMAND       = 18;
  ZSTDERR        = 19;

  {--------------------------------------------------------------------}
  { ZDLE sequences                                                     }
  {--------------------------------------------------------------------}
  ZCRCE          = 104;           { 'h'; }
  ZCRCG          = 105;           { 'i'; }
  ZCRCQ          = 106;           { 'j'; }
  ZCRCW          = 107;           { 'k'; }
  ZRUB0          = 108;           { 'l'; }
  ZRUB1          = 109;           { 'm'; }

  {--------------------------------------------------------------------}
  { ZGetZDL return values                                              }
  { -1 is general error, -2 is timeout                                 }
  {--------------------------------------------------------------------}
  GOTOR          = 256;
  GOTCRCE        = 360;           { (ZCRCE or GOTOR) }
  GOTCRCG        = 361;           { (ZCRCG or GOTOR) }
  GOTCRCQ        = 362;           { (ZCRCQ or GOTOR) }
  GOTCRCW        = 363;           { (ZCRCW or GOTOR) }
  GOTCAN         = 272;           { (GOTOR or 24)    }

  {--------------------------------------------------------------------}
  { Byte positions within header array                                 }
  {--------------------------------------------------------------------}
  ZF0            = 3;
  ZF1            = 2;
  ZF2            = 1;
  ZF3            = 0;
  ZP0            = 0;
  ZP1            = 1;
  ZP2            = 2;
  ZP3            = 3;

  {--------------------------------------------------------------------}
  { Bit Masks for ZRINIT flags byte ZF0                                }
  {--------------------------------------------------------------------}
  CANFDX         = 1;
  CANOVIO        = 2;
  CANBRK         = 4;
  CANCRY         = 8;
  CANLZW         = 16;
  CANFC32        = 32;


  {--------------------------------------------------------------------}
  { PARAMETERS FOR ZFILE FRAME...                                      }
  {--------------------------------------------------------------------}

  {--------------------------------------------------------------------}
  { Conversion options on of these in ZF0                              }
  {--------------------------------------------------------------------}
  ZCBIN          = 1;
  ZCNL           = 2;
  ZCRESUM        = 3;

  {--------------------------------------------------------------------}
  { Management options, one of these in ZF1                            }
  {--------------------------------------------------------------------}
  ZMNEW          = 1;
  ZMCRC          = 2;
  ZMAPND         = 3;
  ZMCLOB         = 4;
  ZMSPARS        = 5;
  ZMDIFF         = 6;
  ZMPROT         = 7;

  {--------------------------------------------------------------------}
  { Transport options, one of these in ZF2                             }
  {--------------------------------------------------------------------}
  ZTLZW          = 1;
  ZTCRYPT        = 2;
  ZTRLE          = 3;

  {--------------------------------------------------------------------}
  { Parameters for ZCOMMAND frame ZF0 (otherwise 0)                    }
  {--------------------------------------------------------------------}
  ZCACK1         = 1;

  {--------------------------------------------------------------------}
  { Miscellaneous definitions                                          }
  {--------------------------------------------------------------------}
  ok             = 0;
  Error          = - 1;
  TimeOut        = - 2;
  RCDO           = - 3;
  FUBAR          = - 4;

  XON            = (Byte('Q') AND 31);
  XOFF           = (Byte('S') AND 31);
  CPMEOF         = (Byte('Z') AND 31);

  RXBINARY       = False;
  RXASCII        = False;
  LZCONV         = 0;
  LZMANAG        = 0;
  LZTRANS        = 0;
  PATHLEN        = 128;
  KSIZE          = 1024;
  WAZOOMAX       : Word = 8192;

  {--------------------------------------------------------------------}
  { Parameters for calling ZModem routines                             }
  {--------------------------------------------------------------------}
  SPEC_COND      = 2;
  ZTRUE          = 1;
  ZFALSE         = 0;
  END_BATCH      = - 1;
  NOTHING_TO_DO  = - 2;
  DELETE_AFTER   = '-';
  SHOW_DELETE_AFTER = '^';
  TRUNC_AFTER    = '#';
  NOTHING_AFTER  = '@';
  DO_WAZOO       = ZTRUE;
  DONT_WAZOO     = ZFALSE;

TYPE
  HeaderType     = ARRAY[0..3] OF Byte;
  BufAry         = ARRAY[0..32768] OF Byte;

VAR
  TxHdr, RxHdr   : HeaderType;
  RxTimeOut      : LongInt;
  RxType, RxFrameInd : Integer;
  RxPos, Crc32   : LongInt;

FUNCTION  ZGetByte(Tenths : Integer) : Integer;
PROCEDURE ZPutString(CONST s: String);
PROCEDURE ZPutLongIntoHeader(Position : LongInt; VAR TxHdr : HeaderType);
PROCEDURE ZSendHexHeader(HdrType : Integer; CONST Hdr : HeaderType);
PROCEDURE ZSendCan;
FUNCTION  ZGetHeader(VAR Hdr : HeaderType) : Integer;
PROCEDURE ZUnCorkTransmitter;
FUNCTION  ZGetZDL : Integer;
FUNCTION  ZTimedRead : Integer;


IMPLEMENTATION

USES OpCrt, OpString, ApTimer,
     Globals, Crc, Com, TransVid, Util, MTask, PoPTypes, LogFile;

  PROCEDURE ZPutHex(HdrType : Integer);
  VAR
    s              : String[2];
  BEGIN
    s:=StLoCase(Hexb(Byte(HdrType)));
    ComPort^.WriteByte(Byte(s[1]), False);
    ComPort^.WriteByte(Byte(s[2]), False);
  END;

  PROCEDURE ZUnCorkTransmitter;
  VAR
    t : EventTimer;
  BEGIN
    IF (NOT ComPort^.OutEmpty) AND ComPort^.Carrier THEN
    BEGIN
      NewTimer(t, Secs2Tics(5 * RxTimeOut) DIV 100);
      REPEAT
{        GiveUpTime};
      UNTIL (TimerExpired(t)) OR (ComPort^.OutEmpty) OR (NOT ComPort^.Carrier);
    END;
    ComPort^.SetXOn(Off);
    ComPort^.SetXOn(On);
  END;

  PROCEDURE ZSendCan;
  VAR
    i : Byte;
  BEGIN
    ComPort^.PurgeOut; ComPort^.PurgeIn;
    FOR i:=1 TO 10 DO
      ComPort^.WriteByte(Can, False);
    FOR i:=1 TO 10 DO
      ComPort^.WriteByte(Bs, i=10);
  END;

  FUNCTION ZTimedRead : Integer;
  VAR
    c              : Integer;
  BEGIN
{$IFDEF ZDebug}
    AddLog('!','ZTimedRead');
{$ENDIF}
    REPEAT
      c:=ZGetByte(RxTimeOut);
      IF c<0 THEN Break;
      c:=c AND $7f;
      CASE c OF
        XON,
        XOFF : Continue;
        Cr,
        Lf,
        ZDLE : Break;
        ELSE   IF (c AND $60)<>0 THEN Break ELSE Continue;
      END;
    UNTIL False;
{$IFDEF ZDebug}
    AddLog('!','END ZTimedRead');
{$ENDIF}
    ZTimedRead:=c;
  END;

(*  FUNCTION ZTimedRead : Integer;
  VAR
    c              : Integer;
  BEGIN
    {$IFDEF ZDebug}
    FastWrite('ZTimedRead              ',1,1,7);
  {$ENDIF}
    WHILE True DO
    BEGIN
      c:=ZGetByte(RxTimeOut);
      IF c < 0 THEN
      BEGIN
        ZTimedRead:=c;
        Exit;
      END;
      CASE (c AND $7f) OF
        XON,
        XOFF : {continue} ;
        Cr,
        Lf,
        ZDLE : BEGIN
                 ZTimedRead:=c;
                 Exit;
               END;
      ELSE                        {IF (c and $60) <> 0 THEN}
        BEGIN
          ZTimedRead:=c;
          Exit;
        END;
      END;
    END;
  END;
*)

  PROCEDURE ZPutLongIntoHeader(Position : LongInt; VAR TxHdr : HeaderType);
  BEGIN
    LongInt(TxHdr):=Position;
  END;

  FUNCTION ZPullLongFromHeader(CONST Hdr : HeaderType) : LongInt;
  BEGIN
    ZPullLongFromHeader:=LongInt(Hdr);
  END;

  FUNCTION ZGetZDL : Integer;
  VAR
    c              : Integer;
  BEGIN
    c:=ZGetByte(RxTimeOut);
    IF c<>ZDLE THEN
    BEGIN
      ZGetZDL:=c;
    END ELSE
    BEGIN
      c:=ZGetByte(RxTimeOut);
      CASE c OF
        RCDO: ZGetZDL:=c; { DWK 16.12.92 }
        Can : BEGIN
                c:=ZGetByte(RxTimeOut);
                IF c<0 THEN ZGetZDL:=c ELSE
                  IF c=CAN THEN
                  BEGIN
                    c:=ZGetByte(RxTimeOut);
                    IF c<0 THEN ZGetZDL:=c ELSE
                    IF c=Can THEN
                    BEGIN
                      c:=ZGetByte(RxTimeOut);
                      IF c<0 THEN ZGetZDL:=c ELSE ZGetZDL:=GOTCAN;
                    END;
                  END;
              END;
        ZCRCE,
        ZCRCG,
        ZCRCQ,
        ZCRCW : ZGetZDL:=(c OR GOTOR);
        ZRUB0 : ZGetZDL:=$7f;
        ZRUB1 : ZGetZDL:=$ff;
        ELSE    BEGIN
                 IF c<0 THEN
                   ZGetZDL:=c
                 ELSE
                   IF ((c AND $60)=$40) THEN
                     ZGetZDL:=(c XOR $40)
                   ELSE
                     ZGetZDL:=Error;
                END;
      END;
    END;
  END;

  FUNCTION ZGetHex: Integer;
  VAR
    c, n : Integer;
  BEGIN
{$IFDEF ZDebug}
    AddLog('!','ZGetHex');
{$ENDIF}
    n:=ZTimedRead;
    IF n<0 THEN
    BEGIN
      ZGetHex:=n;
      Exit;
    END;
    Dec(n, 48);
    IF n>9 THEN Dec(n,39);
    IF (n AND $fff0)<>0 THEN
    BEGIN
      ZGetHex:=Error;
      Exit;
    END;

    c:=ZTimedRead;
    IF c<0 THEN
    BEGIN
      ZGetHex:=c;
      Exit;
    END;
    Dec(c, 48);
    IF c>9 THEN Dec(c, 39);
    IF (c AND $fff0)<>0 THEN
    BEGIN
      ZGetHex:=Error;
      Exit;
    END;
    ZGetHex:=((n SHL 4)+c);
  END;

  FUNCTION ZGetBinaryHeader(VAR Hdr: HeaderType): Integer;
  VAR
    c, n  : Integer;
    Crc16 : Word;
  BEGIN
{$IFDEF ZDebug}
    AddLog('!','ZGetBinaryHeader');
{$ENDIF}
    c:=ZGetZDL;
    IF Hi(c)<>0 THEN
    BEGIN
      ZGetBinaryHeader:=c;
      Exit;
    END;
    RxType:=c;
    Crc16:=UpdCrc16(c, 0);
    FOR n:=0 TO 3 DO
    BEGIN
      c:=ZGetZDL;
      IF Hi(c)<>0 THEN
      BEGIN
        ZGetBinaryHeader:=c;
        Exit;
      END;
      Crc16:=UpdCrc16(c, Crc16);
      Hdr[n]:=c;
    END;
    c:=ZGetZDL;
    IF Hi(c)<>0 THEN
    BEGIN
      ZGetBinaryHeader:=c;
      Exit;
    END;
    Crc16:=UpdCrc16(c, Crc16);
    c:=ZGetZDL;
    IF Hi(c)<>0 THEN
    BEGIN
      ZGetBinaryHeader:=c;
      Exit;
    END;
    Crc16:=UpdCrc16(c, Crc16);
    IF Crc16<>0 THEN
    BEGIN
      ShowError('CRC error',True,false,false);
      ZGetBinaryHeader:=Error;
      Exit;
    END;
    ZGetBinaryHeader:=RxType;
  END;

  FUNCTION Z32GetBinaryHeader(VAR Hdr: HeaderType): Integer;
  VAR
    n     : Byte;
    c     : Integer;
    Crc32 : LongInt;
  BEGIN
{$IFDEF ZDebug}
    AddLog('!','Z32GetBinaryHeader');
{$ENDIF}
    c:=ZGetZDL;
    IF Hi(c)<>0 THEN
    BEGIN
      Z32GetBinaryHeader:=c;
      Exit;
    END;
    RxType:=c;
    Crc32:=$ffffffff;
    Crc32:=UpdCrc32(c, Crc32);
    FOR n:=0 TO 3 DO
    BEGIN
      c:=ZGetZDL;
      IF Hi(c)<>0 THEN
      BEGIN
        Z32GetBinaryHeader:=c;
        Exit;
      END;
      Crc32:=UpdCrc32(c, Crc32);
      Hdr[n]:=c;
    END;
    FOR n:=0 TO 3 DO
    BEGIN
      c:=ZGetZDL;
      IF Hi(c)<>0 THEN
      BEGIN
        Z32GetBinaryHeader:=c;
        Exit;
      END;
      Crc32:=UpdCrc32(c, Crc32);
    END;
    IF Crc32<>$debb20e3 THEN
    BEGIN
      ShowError('CRC error',True,false,false);
      Z32GetBinaryHeader:=Error;
      Exit;
    END;
    Z32GetBinaryHeader:=RxType;
  END;

  FUNCTION ZGetHexHeader(VAR Hdr : HeaderType) : Integer;
  VAR
    c     : Integer;
    Crc16 : Word;
    n     : Byte;
  BEGIN
{$IFDEF ZDebug}
    AddLog('!','ZGetHexHeader');
{$ENDIF}
    c:=ZGetHex;
    IF Hi(c) <> 0 THEN
    BEGIN
      ZGetHexHeader:=c;
      Exit;
    END;
    RxType:=c;
    Crc16:=UpdCrc16(c, 0);
    FOR n:=0 TO 3 DO
    BEGIN
      c:=ZGetHex;
      IF Hi(c) <> 0 THEN
      BEGIN
        ZGetHexHeader:=c;
        Exit;
      END;
      Crc16:=UpdCrc16(Lo(c), Crc16);
      Hdr[n]:=Lo(c);
    END;
    c:=ZGetHex;
    IF Hi(c)<>0 THEN
    BEGIN
      ZGetHexHeader:=c;
      Exit;
    END;
    Crc16:=UpdCrc16(c, Crc16);
    c:=ZGetHex;
    IF Hi(c) <> 0 THEN
    BEGIN
      ZGetHexHeader:=c;
      Exit;
    END;
    Crc16:=UpdCrc16(c, Crc16);
    IF Crc16 <> 0 THEN
    BEGIN
      ShowError('CRC Error',True,false,false);
      ZGetHexHeader:=Error;
      Exit;
    END;
    IF ZGetByte(1)=Cr THEN ZGetByte(1);
    ZGetHexHeader:=RxType;
  END;

  FUNCTION ZGetHeader(VAR Hdr : HeaderType) : Integer;
  LABEL
    Again, Agn2, EndCase2, EndCase3, GOTCAN, Done, Splat;
  VAR
    n              : LongInt;
    CanCount       : ShortInt;
    c              : Integer;
  BEGIN
{$IFDEF ZDebug}
    AddLog('!','ZGetHeader');
{$ENDIF}
    n:=ComPort^.GetBaudRate;
    CanCount:=5;
Again:
{$IFDEF ZDebug}
    AddLog('!','L11');
{$ENDIF}
    IF GotESC THEN
    BEGIN
      ZSendCan;
      ZGetHeader:=ZCAN;
      Exit;
    END;

    RxFrameInd:=0; RxType:=0;
    c:=ZTimedRead;
{$IFDEF BoDebug}
    if c=error then AddLog('!','L1');
{$ENDIF}

    CASE c OF
      ZPAD,
      (ZPAD OR 128) : ;
      RCDO,
      TimeOut : GOTO Done;
      Can : BEGIN
GOTCAN:
{$IFDEF ZDebug}
              AddLog('!','L12');
{$ENDIF}
              Dec(CanCount);
              IF CanCount <= 0 THEN
              BEGIN
                c:=ZCAN;
                GOTO Done;
              END;
              c:=ZGetByte(1);
              CASE c OF
                TimeOut : GOTO Again;
                ZCRCW : BEGIN
                          c:=Error;
                          GOTO Done;
                        END;
                RCDO  : GOTO Done;
                Can   : BEGIN
                          Dec(CanCount);
                          IF CanCount <= 0 THEN
                          BEGIN
                            c:=ZCAN;
                            GOTO Done;
                          END;
                          GOTO Again;
                        END;
              END;
              GOTO Agn2; { DWK 01.03.1993 }
            END;
      ELSE BEGIN
Agn2:
{$IFDEF ZDebug}
    AddLog('!','L10');
{$ENDIF}
        Dec(n);
        IF n <= 0 THEN
        BEGIN
          ShowError('FUBAR',True,false,false);
          ZGetHeader:=Error;
          Exit;
        END;
        IF c <> Can THEN CanCount:=5;
        GOTO Again;
      END;
    END;                          {Case}
{$IFDEF ZDebug}
    AddLog('!','L05');
{$ENDIF}
    CanCount:=5;
Splat:

{$IFDEF ZDebug}
    AddLog('!','L06');
{$ENDIF}
    c:=ZTimedRead;
{$IFDEF BoDebug}
    if c=error then AddLog('!','L2');
{$ENDIF}
    CASE c OF
      ZDLE : {fallthrough} ;
      ZPAD : GOTO Splat;
      RCDO,
      TimeOut : GOTO Done;
      ELSE GOTO Agn2;
    END;
EndCase2:
{$IFDEF ZDebug}
    AddLog('!','L07');
{$ENDIF}

    c:=ZTimedRead;
{$IFDEF BoDebug}
    if c=error then AddLog('!','L3');
{$ENDIF}
    CASE c OF
      ZBIN : BEGIN
               RxFrameInd:=ZBIN;
               Crc32:=0;
               c:=ZGetBinaryHeader(Hdr);
             END;
      ZBIN32 : BEGIN
                 Crc32:=ZBIN32;
                 RxFrameInd:=ZBIN32;
                 c:=Z32GetBinaryHeader(Hdr);
               END;
      ZHEX : BEGIN
               RxFrameInd:=ZHEX;
               Crc32:=0;
               c:=ZGetHexHeader(Hdr);
             END;
      Can : GOTO GOTCAN;
      RCDO,
      TimeOut : GOTO Done;
      ELSE GOTO Agn2;
    END;                          {case}
EndCase3:

{$IFDEF ZDebug}
    AddLog('!','L08');
{$ENDIF}
    RxPos:=ZPullLongFromHeader(Hdr);
Done:
{$IFDEF ZDebug}
    AddLog('!','L09');
{$ENDIF}
    ZGetHeader:=c;
  END;                            {ZGetHeader}

  PROCEDURE ZSendHexHeader(HdrType: Integer; CONST Hdr: HeaderType);
  VAR
    Crc16          : Word;
    n              : Byte;
  BEGIN
{$IFDEF ZDebug}
    AddLog('!','ZSendHexHeader');
{$ENDIF}
    ZUnCorkTransmitter;
    ComPort^.WriteByte(ZPAD, False);
    ComPort^.WriteByte(ZPAD, False);
    ComPort^.WriteByte(ZDLE, False);
    ComPort^.WriteByte(ZHEX, False);
    ZPutHex(HdrType);
    Crc16:=UpdCrc16(HdrType, 0);
    FOR n:=0 TO 3 DO
    BEGIN
      ZPutHex(Hdr[n]);
      Crc16:=UpdCrc16(Hdr[n], Crc16);
    END;
    Crc16:=UpdCrc16(0, Crc16);
    Crc16:=UpdCrc16(0, Crc16);
    ZPutHex(Hi(Crc16));
    ZPutHex(Lo(Crc16));
    IF (HdrType <> ZFIN) AND (HdrType <> ZACK) THEN ComPort^.WriteByte(17, False);
    ComPort^.WriteByte(Cr, False);
    ComPort^.WriteByte(Lf, True);
    IF NOT ComPort^.Carrier THEN ComPort^.PurgeOut;
  END;

  PROCEDURE ZPutString(CONST s: String);
  VAR
    a              : Byte;
  BEGIN
    FOR a:=1 TO Length(s) DO
      CASE Byte(s[a]) OF
        222 : Pause(200);
        221 : {ZsendBreak} ;
        ELSE ComPort^.WriteByte(Byte(s[a]), a=Length(s));
      END;
    ZUnCorkTransmitter;
  END;

  FUNCTION ZGetByte(Tenths: Integer) : Integer;
  VAR
    TOut : EventTimer;
  BEGIN
{
    IF NOT FCarrier THEN
    BEGIN
      ZGetByte:=RCDO;
      Exit;
    END;
}
    IF ComPort^.Keypressed THEN
    BEGIN
      ZGetByte:=Integer(ComPort^.ReadByte);
    END ELSE
    BEGIN
      NewTimer(TOut, Secs2Tics(Tenths*10) DIV 100);
      REPEAT
        IF NOT ComPort^.Carrier THEN
        BEGIN
          ZGetByte:=RCDO;
          Exit;
        END;
        IF ComPort^.Keypressed THEN
        BEGIN
          ZGetByte:=Integer(ComPort^.ReadByte);
          Exit;
        END;
        IF GotESC THEN
        BEGIN
          ZGetByte:=Error;
          Exit;
        END;
      UNTIL TimerExpired(TOut);
      ZGetByte:=TimeOut;
    END;
  END;

END.